home *** CD-ROM | disk | FTP | other *** search
/ APDL Eductation Resources / APDL Eductation Resources.iso / programs / maths / factors / !Factors / !RunImageT < prev    next >
Encoding:
Text File  |  1992-04-19  |  11.2 KB  |  441 lines
  1. 10REM > <Factors$Dir>.!RunImage
  2. 20
  3. 30DIM q% 2500
  4. 40$q%="TASK"
  5. 50SYS "Wimp_Initialise",200,!q%,"Factors" TO ,task%
  6. 60SYS "Wimp_ClaimInterface",task%
  7. 70SYS "Hourglass_On"
  8. 80:
  9. 90S%=OPENIN "<Factors$Dir>.!Sprites":T%=EXT#S%+16:CLOSE #S%
  10. 100DIM sp T%:!sp=T%:sp!4=0
  11. 110sp!8=16:sp!12=16
  12. 120SYS "OS_SpriteOp",&209,sp
  13. 130SYS "OS_SpriteOp",&20A,sp,"<Factors$Dir>.!Sprites"
  14. 140sicon=FNicon_create(-1,0,0,68,68,0,0,&3002,"!Factors")
  15. 150:
  16. 160DIM text$(50),setting(50),flags(50)
  17. 170DIM submenu(50),ref(50),menupos(20)
  18. 180DIM menu% 512
  19. 190DIM indirect% &2000
  20. 200DIM msgblk% 256
  21. 210sendtofile$=""
  22. 220my_filetype%=&FFF
  23. 230numbert$=""
  24. 240iptr%=indirect%:iend%=iptr%+&2000
  25. 250ON ERROR OSCLI "Error "+REPORT$+" : "+STR$(ERL)
  26. 260:
  27. 270PROCopentemplatefile("<Factors$Dir>.Templates")
  28. 280PROCloadtemplate("main")
  29. 290SYS "Wimp_CreateWindow",,q% TO main%
  30. 300PROCloadtemplate("info")
  31. 310SYS "Wimp_CreateWindow",,q% TO info%
  32. 320PROCloadtemplate("save")
  33. 330SYS "Wimp_CreateWindow",,q% TO save%
  34. 331PROCloadtemplateasd("me")
  35. 332SYS "Wimp_CreateWindow",,q% TO me%
  36. 340PROCclosetemplatefile
  37. 350:
  38. 360PROCicon_putdata(q%,main%,5,"Ready",0)
  39. 370SYS "Hourglass_Off"
  40. 380REPEAT
  41. 390  PROCaction(FNpoll(0))
  42. 400UNTIL FALSE
  43. 410:
  44. 420DEFPROCclosedown
  45. 430$q%="TASK"
  46. 440SYS "Wimp_CloseDown",task%,q%!0
  47. 450END
  48. 460ENDPROC
  49. 470:
  50. 480DEFPROCclickwindow(mousex%,mousey%,button%,handle%,icon%,ob%)
  51. 490CASE handle% OF
  52. 500  WHEN main% :PROCclickmain(button%,icon%)
  53. 510  WHEN save% :PROCclicksave(button%,icon%)
  54. 515  WHEN info% :PROCclickinfo(button%,icon%)
  55. 516  WHEN me%   :PROCclickme(button%,icon%)
  56. 520  WHEN -2    :PROCclickiconbar(button%,icon%)
  57. 530ENDCASE
  58. 540ENDPROC
  59. 550:
  60. 560DEFPROCclickiconbar(button%,icon%)
  61. 570IF icon%<0 THEN ENDPROC
  62. 580CASE TRUE OF
  63. 590  WHEN button%=2
  64. 600    IF icon%=sicon THEN
  65. 610      PROCmenu_sicon
  66. 620    ENDIF
  67. 630  WHEN button%=4
  68. 640      PROCopenwindow(main%,FALSE,-1)
  69. 650      open%=TRUE
  70. 660    ENDIF
  71. 670ENDCASE
  72. 680ENDPROC
  73. 690:
  74. 700DEFPROCmenu_sicon
  75. 710no=0:MOUSE x,y,b
  76. 720PROCdefine_menu_text("Info",no,0,0,0,0,&10021,info%,0):no+=1
  77. 730PROCdefine_menu_text("Quit",no,0,0,0,0,&10021,0,-1):no+=1
  78. 740PROCcreate_menu("Factors",no,100,x-64,96+(no*40))
  79. 750menu_nr%=0
  80. 760claimmenu$="sicon"
  81. 770ENDPROC
  82. 780:
  83. 790DEFPROCreceive(q%)
  84. 800CASE q%!16 OF
  85. 810WHEN 0 :PROCclosedown
  86. 820WHEN 2 :PROCdatasave(q%)
  87. 830ENDCASE
  88. 840ENDPROC
  89. 850:
  90. 860DEFPROCopenwindow(handle%,full%,front%)
  91. 870q%!0=handle%
  92. 880IF NOT full% THEN SYS "Wimp_GetWindowState",0,q%
  93. 890IF front% THEN q%!28=-1
  94. 900SYS "Wimp_OpenWindow",0,q%
  95. 910ENDPROC
  96. 920
  97. 930DEFPROCclosewindow(handle%)
  98. 940IF FNoktoclosew(handle%) THEN
  99. 950  q%!0=handle%
  100. 960  SYS "Wimp_CloseWindow",0,q%
  101. 970ENDIF
  102. 980ENDPROC
  103. 990
  104. 1000DEFFNpoll(mask%)
  105. 1010SYS "Wimp_Poll",mask%,q% TO a%
  106. 1020SYS "Wimp_PollPointer",a%,,task%
  107. 1030=a%
  108. 1040
  109. 1050DEFPROCaction(evnt%)
  110. 1060CASE evnt% OF
  111. 1070  WHEN 0:PROCdo_background_task
  112. 1080  WHEN 1:PROCredrawwindow(q%!0)
  113. 1090  WHEN 2:PROCopenwindow(q%!0,TRUE,0)
  114. 1100  WHEN 3:PROCclosewindow(q%!0)
  115. 1110  WHEN 4:
  116. 1120  WHEN 5:
  117. 1130  WHEN 6:PROCclickwindow(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
  118. 1140  WHEN 7:IF claimdrag$<>"" THEN junk=EVAL("FNuserdrag_"+claimdrag$)
  119. 1150  WHEN 8:
  120. 1160  WHEN 9:IF claimmenu$<>"" THEN PROCwhichmenu(claimmenu$)
  121. 1170  WHEN 17,18:PROCreceive(q%)
  122. 1180ENDCASE
  123. 1190ENDPROC
  124. 1200
  125. 1210DEFPROCreceive(q%)
  126. 1220CASE q%!16 OF
  127. 1230WHEN 0    :$q%="TASK":SYS "Wimp_CloseDown",task%,q%!0:END
  128. 1240ENDCASE
  129. 1250ENDPROC
  130. 1260
  131. 1270DEFPROClwaorigin(b,RETURN x%,RETURN y%)
  132. 1280x%=b!0-b!16:y%=b!12-b!20
  133. 1290ENDPROC
  134. 1300
  135. 1310DEFFNicon_create(window%,minx%,miny%,width%,height%,fg%,bg%,flg%,data$)
  136. 1320LOCAL i%
  137. 1330q%!0=window%
  138. 1340q%!4=minx%:q%!8=miny%
  139. 1350q%!12=minx%+width%:q%!16=miny%+height%
  140. 1360q%!20=flg% OR bg%<<28 OR fg%<<24
  141. 1370IF q%!20 AND &100 THEN
  142. 1380  i%=INSTR(data$,",")
  143. 1390  q%!24=EVAL(LEFT$(data$,i%-1))
  144. 1400  q%!28=-1
  145. 1410  q%!32=EVAL(MID$(data$,i%+1))
  146. 1420ELSE
  147. 1430$(q%+24)=LEFT$(data$,11)
  148. 1440ENDIF
  149. 1450SYS "Wimp_CreateIcon",0,q% TO i%
  150. 1460=i%
  151. 1470
  152. 1480DEFPROCicon_putdata(b,wh%,ih%,text$,rd)
  153. 1490b!0=wh%:b!4=ih%
  154. 1500SYS "Wimp_GetIconState",,b
  155. 1510SYS "Wimp_DeleteIcon",,b
  156. 1520b!4=wh%:$(b!28)=text$:b+=4
  157. 1530SYS "Wimp_CreateIcon",,b
  158. 1540IF rd THEN SYS "Wimp_ForceRedraw",b!0,b!4,b!8,b!12,b!16
  159. 1550b-=4
  160. 1560ENDPROC
  161. 1570
  162. 1580DEFPROCicon_putdata(q%,whandle%,ihandle%,data$,redraw)
  163. 1590q%!0=whandle%
  164. 1600q%!4=ihandle%
  165. 1610SYS "Wimp_GetIconState",,q%
  166. 1620$(q%!28)=data$
  167. 1630IF redraw THEN
  168. 1640  SYS "Wimp_ForceRedraw",whandle%,q%!8,q%!12,q%!16,q%!20
  169. 1650ENDIF
  170. 1660ENDPROC
  171. 1670
  172. 1680DEFFNicon_getdata(q%,whandle%,ihandle%)
  173. 1690q%!0=whandle%
  174. 1700q%!4=ihandle%
  175. 1710SYS "Wimp_GetIconState",,q%
  176. 1720=$(q%!28)
  177. 1730
  178. 1740DEFPROCnewvals
  179. 1750gtx=q%!36:gty=q%!40
  180. 1760wbx=q%!4:wby=q%!8
  181. 1770wtx=q%!12:wty=q%!16
  182. 1780xsc=q%!20:ysc=q%!24
  183. 1790hp=wtx-wbx:vp=wty-wby:ebx=xsc
  184. 1800etx=xsc+hp:ety=ysc:eby=ysc-vp
  185. 1810ENDPROC
  186. 1820
  187. 1830DEFPROCdefine_menu_text(text$,n,w,t,d,s,flags,sm,l)
  188. 1840text$(n)=text$
  189. 1850setting(n)=0
  190. 1860IF w THEN setting(n)=setting(n) OR &04:flags=flags OR &100
  191. 1870IF t THEN setting(n)=setting(n) OR &01
  192. 1880IF d THEN setting(n)=setting(n) OR &02
  193. 1890IF l THEN setting(n)=setting(n) OR &80
  194. 1900IF s THEN flags=flags OR &400000
  195. 1910flags(n)=flags
  196. 1920submenu(n)=sm
  197. 1930ENDPROC
  198. 1940
  199. 1950DEFPROCcreate_menu(title$,n,width%,x,y)
  200. 1960mb%=menu%
  201. 1970menus=0:q=0
  202. 1980REPEAT
  203. 1990  menupos(menus)=mb%:menus+=1
  204. 2000  $mb%=title$
  205. 2010  mb%?12=7
  206. 2020  mb%?13=2
  207. 2030  mb%?14=7
  208. 2040  mb%?15=0
  209. 2050  mb%!16=width%
  210. 2060  mb%!20=40 :REM height of menu items
  211. 2070  mb%!24=0  :REM vertical gap between items (also top & bottom)
  212. 2080  itemptr=mb%+28
  213. 2090  REPEAT
  214. 2100    itemptr!0=setting(q)
  215. 2110    ref(q)=itemptr+4
  216. 2120    itemptr!8=flags(q) OR 0<<28 OR 7<<24
  217. 2130    IF (flags(q) AND &100)=0 THEN
  218. 2140      $(itemptr+12)=text$(q)
  219. 2150    ELSE
  220. 2160      pos=INSTR(text$(q),"(")
  221. 2170      itemptr!12=EVAL(LEFT$(text$(q),pos-1))
  222. 2180      itemptr!16=-1
  223. 2190      itemptr!20=EVAL(RIGHT$(text$(q),LEN(text$(q))-pos))
  224. 2200    ENDIF
  225. 2210    itemptr+=24:q+=1
  226. 2220  UNTIL (setting(q-1) AND &80)>0
  227. 2230  mb%=itemptr
  228. 2240  IF q<>n THEN title$=text$(q):q+=1
  229. 2250UNTIL q=n
  230. 2260
  231. 2270FOR q=0 TO n-1
  232. 2280  IF submenu(q)>0 AND submenu(q)<menus THEN
  233. 2290    !ref(q)=menupos(submenu(q))
  234. 2300  ELSE
  235. 2310    !ref(q)=submenu(q):REM was -1 i.e. submenu disallowed! This change
  236. 2320                      :REM allows a window handle to be used
  237. 2330  ENDIF
  238. 2340NEXT q
  239. 2350SYS "Wimp_CreateMenu",,menu%,x,y
  240. 2360ENDPROC
  241. 2370
  242. 2380DEFPROCopentemplatefile(file$)
  243. 2390SYS "Wimp_OpenTemplate",,file$
  244. 2400ENDPROC
  245. 2410
  246. 2420DEFPROCloadtemplate(name$)
  247. 2430LOCAL type%,pos%,x%
  248. 2440SYS "Wimp_LoadTemplate",,q%,iptr%,iend%,-1,name$,0 TO type%,,iptr%,,,,pos%
  249. 2450ENDPROC
  250. 2451
  251. 2452DEFPROCloadtemplateasd(name$)
  252. 2453LOCAL type%,pos%,x%
  253. 2454SYS "Wimp_LoadTemplate",,q%,iptr%,iend%,-1,name$,0 TO type%,,iptr%,,,,pos%
  254. 2455GOTO 332
  255. 2460
  256. 2470DEFPROCclosetemplatefile
  257. 2480SYS "Wimp_CloseTemplate"
  258. 2490ENDPROC
  259. 2500
  260. 2510DEFFNleaf(path$)
  261. 2520WHILE INSTR(path$,".")
  262. 2530  path$=MID$(path$,INSTR(path$,".")+1)
  263. 2540ENDWHILE
  264. 2550=path$
  265. 2560
  266. 2570DEFFNgname(ptr)
  267. 2580f$=""
  268. 2590WHILE ?ptr<>0 AND ?ptr<>13
  269. 2600  f$=f$+CHR$?ptr:ptr+=1
  270. 2610ENDWHILE
  271. 2620=f$
  272. 2630
  273. 2640DEFPROCdo_background_task
  274. 2650ENDPROC
  275. 2660
  276. 2670DEFPROCredrawwindow(handle%)
  277. 2680LOCAL void%
  278. 2690q%!0=handle%
  279. 2700SYS "Wimp_RedrawWindow",0,q% TO more%
  280. 2710PROClwaorigin(q%+4,x0%,y0%)
  281. 2720WHILE more%
  282. 2730  PROCnewvals
  283. 2740  CASE handle% OF
  284. 2750  ENDCASE
  285. 2760  SYS "Wimp_BorderWindow",,q%
  286. 2770  SYS "Wimp_GetRectangle",0,q% TO more%
  287. 2780ENDWHILE
  288. 2790ENDPROC
  289. 2800:
  290. 2810DEFFNoktoclosew(handle%)
  291. 2820LOCAL shutting%
  292. 2830shutting%=TRUE
  293. 2840=shutting%
  294. 2850
  295. 2860DEFPROCclickmain(button%,icon%)
  296. 2870CASE TRUE OF
  297. 2880WHEN (button% AND 4)=4 AND icon%<>-1 OR (button% AND 1)=1 AND icon%<>-1
  298. 2890  CASE icon% OF
  299. 2900  WHEN 3 :PROCslabicon
  300. 2910          PROCopenwindow(save%,FALSE,-1)
  301. 2920  WHEN 4 :PROCslabicon
  302. 2930          PROCextractfactors
  303. 2940  ENDCASE
  304. 2950ENDCASE
  305. 2960ENDPROC
  306. 2970:
  307. 2980DEFPROCslabicon
  308. 2990SYS "Wimp_BorderIcon",,q%
  309. 3000q%!8=0
  310. 3010SYS "Wimp_BorderIcon",,q%
  311. 3020ENDPROC
  312. 3030:
  313. 3040DEFPROCclicksave(button%,icon%)
  314. 3050CASE TRUE OF
  315. 3060WHEN (button% AND 4)=4 AND icon%=5
  316. 3070  PROCslabicon:PROCsavefile(FNicon_getdata(q%,save%,4))
  317. 3080WHEN (button% AND 4)=4 AND icon%=3
  318. 3090  claimdrag$="save"
  319. 3100  !q%=save%
  320. 3110  SYS "Wimp_GetWindowState",,q%
  321. 3120  wex=q%!4-q%!20
  322. 3130  wey=q%!16-q%!24
  323. 3140  q%!4=3
  324. 3150  SYS "Wimp_GetIconState",,q%
  325. 3160  !q%=save%:q%!4=5
  326. 3170  q%!8=q%!8+wex
  327. 3180  q%!12=q%!12+wey
  328. 3190  q%!16=q%!16+wex
  329. 3200  q%!20=q%!20+wey
  330. 3210  q%!24=0:q%!28=0
  331. 3220  q%!32=&7FFFFFFF:q%!36=&7FFFFFFF
  332. 3230  SYS "Wimp_DragBox",,q%
  333. 3240ENDCASE
  334. 3250ENDPROC
  335. 3260
  336. 3270DEFFNuserdrag_save
  337. 3280SYS "Wimp_GetPointerInfo",,msgblk%
  338. 3290msgblk%!20=64:msgblk%!32=0
  339. 3300msgblk%!36=1:msgblk%!40=msgblk%!12
  340. 3310msgblk%!44=msgblk%!16
  341. 3320msgblk%!48=!msgblk%
  342. 3330msgblk%!52=msgblk%!4
  343. 3340msgblk%!56=&100
  344. 3350msgblk%!60=my_filetype%
  345. 3360$(msgblk%+64)=FNleaf(FNicon_getdata(q%,save%,4))
  346. 3370SYS "Wimp_SendMessage",17,msgblk%+20,msgblk%!12,msgblk%!16
  347. 3380=0
  348. 3390
  349. 3400DEFPROCextractfactors
  350. 3410PROCicon_putdata(q%,main%,5,"Extracting factors",1)
  351. 3420PROCicon_putdata(q%,main%,5,"Extracting factors",1)
  352. 3430numbert$=FNicon_getdata(q%,main%,1)
  353. 3440IF numbert$="" THEN PROCicon_putdata(q%,main%,5,"Please enter a number",1):ENDPROC
  354. 3450number%=VAL(numbert$)
  355. 3460sendtofile$=""
  356. 3470SYS "Hourglass_On"
  357. 3480FOR vara=1 TO number%
  358. 3485  SYS "Hourglass_Percentage",(vara/number%)*100
  359. 3490  FOR varb=1 TO number%
  360. 3500    IF number%/vara=varb THEN sendtofile$=sendtofile$+""+STR$(vara)+", "
  361. 3510  NEXT varb
  362. 3520NEXT vara
  363. 3530SYS "Hourglass_Off"
  364. 3540PROCicon_putdata(q%,main%,5,"Finished, please save file",1)
  365. 3550ENDPROC
  366. 3560
  367. 3570(menu$)
  368. 3580LOCAL void%
  369. 3590CASE menu$ OF
  370. 3600  WHEN "sicon" :void%=FNmenuselect_sicon
  371. 3610ENDCASE
  372. 3620ENDPROC
  373. 3630
  374. 3640DEFFNmenuselect_sicon
  375. 3650LOCAL level0
  376. 3660level0=q%!0
  377. 3670CASE level0 OF
  378. 3680  WHEN 0 :PROCopenwindow(info%,FALSE,-1)
  379. 3690  WHEN 1 :PROCclosedown
  380. 3700ENDCASE
  381. 3710=0
  382. 3720
  383. 3730DEFPROCdatasave(b)
  384. 3740PROCsavefile(FNgname(b+44))
  385. 3750b!12=b!8:b!16=3:!b=64
  386. 3760SYS "Wimp_SendMessage",17,b,b!20,b!24
  387. 3770ENDPROC
  388. 3780
  389. 3790DEFPROCsavefile(file$)
  390. 3800LOCAL X%
  391. 3810IF (INSTR(file$,".")=0 AND INSTR(file$,":")=0) THEN
  392. 3820     : SYS "Wimp_ReportError","....To save, please drag the text icon to a directory viewer",&14,"Message from Factors" TO response%
  393. 3830     : ENDPROC
  394. 3840ENDIF
  395. 3850SYS "Hourglass_On"
  396. 3860Exec%=q%!0
  397. 3870Load%=q%?4
  398. 3880Load%=(Load% AND &FF) OR (&FFF<<20) OR (&FFF<<8)
  399. 3890SYS "OS_File",7,file$,Load%,Exec%,0,0
  400. 3900SYS "OS_Find",204,file$ TO chan%
  401. 3910BPUT#chan%,"Factors program output file"
  402. 3920BPUT#chan%,"---------------------------"
  403. 3930BPUT#chan%," "
  404. 3940BPUT#chan%,"File generated : "+TIME$
  405. 3950BPUT#chan%," "
  406. 3960BPUT#chan%,"Base number that factors were extracted from : "+numbert$
  407. 3970BPUT#chan%," "
  408. 3980BPUT#chan%,"Factors : "+sendtofile$
  409. 3990CLOSE#chan%
  410. 4000OSCLI "SetType "+file$+" &FFF"
  411. 4005PROCicon_putdata(q%,save%,4,file$,1)
  412. 4010SYS "Hourglass_Off"
  413. 4020ENDPROC
  414. 4030
  415. 6870DEFPROCwhichmenu(menu$)
  416. 6880LOCAL void%
  417. 6890CASE menu$ OF
  418. 6910  WHEN "sicon" :void%=FNmenuselect_sicon
  419. 6920ENDCASE
  420. 6930ENDPROC
  421. 6940:
  422. 6950DEFPROCclickinfo(button%,icon%)
  423. 6960CASE TRUE OF
  424. 6970WHEN (button% AND 4)=4 AND icon%<>-1 OR (button% AND 1)=1 AND icon%<>-1
  425. 6980  CASE icon% OF
  426. 6990    WHEN 2 :PROCslabicon
  427. 6998            PROCopenwindow(me%,FALSE,-1)
  428. 7000  ENDCASE
  429. 7010ENDCASE
  430. 7020ENDPROC
  431. 7030
  432. 7040DEFPROCclickme(button%,icon%)
  433. 7050CASE TRUE OF
  434. 7060WHEN (button% AND 4)=4 AND icon%<>-1 OR (button% AND 1)=1 AND icon%<>-1
  435. 7070  CASE icon% OF
  436. 7080    WHEN 12 :PROCslabicon
  437. 7090             PROCclosewindow(me%)
  438. 7100   ENDCASE
  439. 7110ENDCASE
  440. 7120ENDPROC
  441.